home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / BUGFILT.CLS < prev    next >
Text File  |  1997-06-14  |  5KB  |  177 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "CBugFilter"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = False
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Option Explicit
  11.  
  12. ' CBugFilter implements IFilter
  13. Implements IFilter
  14.  
  15. Enum EFilterType
  16.     eftMinFilter = 0
  17.     eftDisableBug = 0
  18.     eftEnableBug
  19.     eftDisableProfile
  20.     eftEnableProfile
  21.     eftExpandAsserts
  22.     eftTrimAsserts
  23.     eftMaxFilter
  24. End Enum
  25. Private eftFilterType As EFilterType
  26.  
  27. Const sBug = "Bug"
  28. Const sProfile = "Profile"
  29. Const sComment = "'"
  30. Const sBugAssert = "BugAssert "
  31.  
  32. ' Implementation of IFilter interface
  33. Private sSource As String, sTarget As String
  34.  
  35. Private Property Get IFilter_Source() As String
  36.     IFilter_Source = sSource
  37. End Property
  38. Private Property Let IFilter_Source(sSourceA As String)
  39.     sSource = sSourceA
  40. End Property
  41.  
  42. Private Property Get IFilter_Target() As String
  43.     IFilter_Target = sTarget
  44. End Property
  45. Private Property Let IFilter_Target(sTargetA As String)
  46.     sTarget = sTargetA
  47. End Property
  48.  
  49. Private Function IFilter_Translate(sLine As String, _
  50.                                    ByVal iLine As Long) As EChunkAction
  51.     IFilter_Translate = ecaTranslate  ' Always translate with this filter
  52.     
  53.     Select Case eftFilterType
  54.     Case eftDisableBug
  55.         CommentOut sLine, sBug
  56.     Case eftEnableBug
  57.         CommentIn sLine, sBug
  58.     Case eftDisableProfile
  59.         CommentOut sLine, sProfile
  60.     Case eftEnableProfile
  61.         CommentIn sLine, sProfile
  62.     Case eftExpandAsserts
  63.         ExpandAsserts sLine, iLine
  64.     Case eftTrimAsserts
  65.         TrimAsserts sLine
  66.     End Select
  67. End Function
  68.  
  69. Property Get FilterType() As EFilterType
  70.     FilterType = eftFilterType
  71. End Property
  72.  
  73. Property Let FilterType(eftFilterTypeA As EFilterType)
  74.     If eftFilterTypeA >= eftMinFilter And _
  75.        eftFilterTypeA <= eftMaxFilter Then
  76.         eftFilterType = eftFilterTypeA
  77.     Else
  78.         eftFilterType = eftMaxFilter
  79.     End If
  80. End Property
  81.  
  82. Private Sub CommentOut(sLine As String, sTarget As String)
  83.     
  84.     ' Check to see if line contains target
  85.     Dim iPos As Integer
  86.     iPos = InStr(sLine, sTarget)
  87.     If iPos Then
  88.     
  89.         ' If text is first nonblank, comment it out
  90.         Dim s As String
  91.         s = Space$(iPos - 1)
  92.         If Left$(sLine, iPos - 1) = s Then
  93.             sLine = s & sComment & Mid$(sLine, iPos)
  94.         End If
  95.     End If
  96.             
  97. End Sub
  98.  
  99. Private Sub CommentIn(sLine As String, sTarget As String)
  100.     
  101.     ' Check to see if line contains string
  102.     Dim iPos As Integer
  103.     iPos = InStr(sLine, sComment & sTarget)
  104.     If iPos Then
  105.     
  106.         ' If text is first nonblank, comment it in
  107.         Dim s As String
  108.         s = Space$(iPos - 1)
  109.         If Left$(sLine, iPos - 1) = s Then
  110.             sLine = s & Mid$(sLine, iPos + 1)
  111.         End If
  112.     End If
  113.             
  114. End Sub
  115.  
  116. Private Sub ExpandAsserts(sLine As String, iLine As Long)
  117.     
  118.     Dim iPos As Integer, i As Integer, sComment As String
  119.     ' Check to see if line contains Bug string
  120.     iPos = InStr(sLine, sBugAssert)
  121.     If iPos Then
  122.     
  123.         ' Save comment so it won't be processed
  124.         i = InStr(sLine, "'")
  125.         If i Then
  126.             ' Ignore commented out Bug strings
  127.             If iPos > i Then Exit Sub
  128.             ' Remove comment
  129.             sComment = Mid$(sLine, i)
  130.             sLine = Left$(sLine, i - 1)
  131.         End If
  132.         ' Move to first argument
  133.         iPos = iPos + Len(sBugAssert)
  134.         
  135.         ' If it already has a second argument, replace
  136.         i = InStr(iPos, sLine, ",")
  137.         If i Then sLine = Left$(sLine, i - 1)
  138.             
  139.         ' Add second argument
  140.         Dim s As String
  141.         s = Mid$(sLine, iPos)
  142.         sLine = sLine & ", """ & s & ", file " & _
  143.                 sSource & ", line " & iLine & """"
  144.         If sComment <> sEmpty Then sLine = sLine & " " & sComment
  145.     End If
  146.             
  147. End Sub
  148.  
  149. Private Sub TrimAsserts(sLine As String)
  150.     
  151.     ' Check to see if line contains string
  152.     Dim iPos As Integer, i As Integer, sComment As String
  153.     iPos = InStr(sLine, sBugAssert)
  154.     If iPos Then
  155.     
  156.         ' Save comment so it won't be processed
  157.         i = InStr(sLine, "'")
  158.         If i Then
  159.             ' Ignore commented out Bug strings
  160.             If iPos > i Then Exit Sub
  161.             ' Remove comment
  162.             sComment = Mid$(sLine, i)
  163.             sLine = Left$(sLine, i - 1)
  164.         End If
  165.         ' Move to first argument
  166.         iPos = iPos + Len(sBugAssert)
  167.         
  168.         ' Remove any second argument
  169.         i = InStr(iPos, sLine, ",")
  170.         If i Then sLine = Left$(sLine, i - 1)
  171.         If sComment <> sEmpty Then sLine = sLine & sComment
  172.             
  173.     End If
  174.             
  175. End Sub
  176.  
  177.